home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbsubs.arc / MASTER1.BAS < prev    next >
BASIC Source File  |  1986-10-27  |  10KB  |  252 lines
  1. '******************************************************************************
  2. '* 05/05/86                                                          VER 1.0  *
  3. '*                 ***        MASTER FORMAT FOR       ****                    *
  4. '*                                                                            *
  5. '*                                QUICKBASIC                                  *
  6. '*                                                                            *
  7. '* (c) 1986 by DAVID WESSON, PhD.  238 S. Quaker La. W.Hartford, CT 06119     *
  8. '******************************************************************************
  9.      goto TOP
  10. '************************** GENERAL SUBROUTINES *******************************
  11. COMMANDLINE:                                'read arguments on DOS command line
  12.      com$=command$                          'will not operate within QuickBASIC
  13.      length=len(com$)                       'screen editor, but from outside
  14.      max=(length/2)+1
  15.      dim arg$(max)
  16.      true=-1:false=0:i=1:num=0:inword=true
  17.      while i <= length
  18.           ch$=mid$(com$,i,1)
  19.           if ch$ <> " " then
  20.                if not inword then inword = true
  21.                arg$(num) = arg$(num) + ch$
  22.           elseif inword then
  23.                num =num+1
  24.                inword=false
  25.           end if
  26.           i = i+1
  27.      wend
  28.      y=1
  29.      if not arg$(0)="" then goto BEGINNING
  30.      return
  31. DRAWFRAME:                                                  'draws screen frame
  32.      locate 1,1,0,8:print chr$(201);string$(77,205);chr$(187)
  33.      for x=2 to 22:locate x,79:print chr$(186):next
  34.      for x=22 to 2 step -1:locate x,1:print chr$(186):next
  35.      locate 23,1:print chr$(200);string$(77,205);chr$(188)
  36.      return
  37. DRAW3:
  38.      locate 3:print chr$(199);string$(77,196);chr$(182):return 
  39. DRAW21:
  40.      locate 21:print chr$(199);string$(77,196);chr$(182):return 
  41. CLEARALL:
  42.      for x=20 to 4 step -1:locate x,2:print string$(77,0):next:return 
  43. CLEAR22:
  44.      locate 22,2:print string$(77,0):return 
  45. PRESS:
  46.      gosub CLEAR22
  47.      locate 22,27:print "PRESS ANY KEY TO CONTINUE " 
  48. IN:
  49.      w$=inkey$:if w$="" then goto IN else return
  50. ENTER:
  51.      gosub IN
  52.      answer$=w$:if answer$=enter$ then return
  53.      goto ENTER
  54. ANOTHER:
  55.      gosub CLEAR22
  56.      locate 22,25: print "WANT TO DO ANOTHER? ( Y or N )"
  57.      gosub YESNO
  58. YESNO:
  59.      gosub IN
  60.      if w$="Y" or w$="y" then yn$="y":return
  61.      if w$="N" or w$="n" then yn$="n":return
  62.      goto YESNO
  63. BANNER:
  64.     'input message, banner length and location, and escape character
  65.     mlen=40:row=10:col=20:stop$=esc$
  66.     m$="Hit [Esc] to exit"
  67.     locate row,col:color 0,7:print string$(mlen,46)
  68.     banstart:
  69.          for z=1 to len(m$)
  70.                n=n+1:newcol=col+mlen-n
  71.                      locate row,col:print right$(m$,len(m$)-n);chr$(46)
  72.                      locate row,newcol:print left$(m$,n);chr$(46)
  73.                for i=1 to 400:next i                      'viewing scroll delay
  74.                if inkey$=stop$ then color 7,0:return
  75.          next z
  76.          for y=1 to mlen-len(m$)
  77.                p=p+1:newcol=col+mlen-len(m$)-p
  78.                     locate row,newcol:print m$;chr$(46)
  79.                for i=1 to 400:next i
  80.                if inkey$=stop$ then color 7,0:return
  81.          next y
  82.          n=0:p=0:newcol=0
  83.     goto banstart
  84.     return
  85. '------------------------- SET UP KEY and COLOR NAMES -------------------------
  86. SETNAMES:
  87. DISABLE:
  88.     defint a-z
  89.     key off
  90.     for i=1 to 10:key i,"":next     
  91. NAMEKEYS:
  92.     PGUP$ = chr$(0)+chr$(73) 
  93.     PGDOWN$ = chr$(0)+chr$(81)
  94.     HOME$ = chr$(0)+chr$(71)
  95.     ENTER$= chr$(13)         
  96.     BKSP$ = chr$(8)
  97.     ESC$  = chr$(27)
  98.     F1$ = chr$(0)+chr$(59) : F2$ = chr$(0)+chr$(60)
  99.     F3$ = chr$(0)+chr$(61) : F4$ = chr$(0)+chr$(62)
  100.     F5$ = chr$(0)+chr$(63) : F6$ = chr$(0)+chr$(64)
  101.     F7$ = chr$(0)+chr$(65) : F8$ = chr$(0)+chr$(66)
  102.     F9$ = chr$(0)+chr$(67) : F10$= chr$(0)+chr$(68)
  103.     UP$   = chr$(0)+chr$(72)
  104.     LFT$ = chr$(0)+chr$(14)
  105.     RGHT$= chr$(0)+chr$(77)
  106.     DOWN$ = chr$(0)+chr$(80)
  107. NAMECOLORS:
  108.     BLACK = 0:GRAY  = 8          
  109.     BLUE  = 1:LTBLUE= 9
  110.     GREEN = 2:LTGREEN=10
  111.     CYAN  = 3:LTCYAN= 11         
  112.     RED   = 4:LTRED = 12
  113.     MAGENTA=5:LTMAGENTA=13
  114.     BROWN = 6:YELLOW=14
  115.     WHITE = 7:LTWHITE= 15
  116.     BLINK= 16             'use w/color ie black+blink gives you blinking black
  117.     return
  118. '---------------------- GET INPUT FROM KEYBOARD --------------------------------
  119. ANSWER:
  120.      answer$=""
  121.      inrow=csrlin:incol=pos(0):inlen=78-incol
  122. BYTEIN:
  123.      byte$=inkey$:if byte$="" then goto BYTEIN
  124.          if byte$=ENTER$ then return
  125.          if byte$=BKSP$ goto BACKSPACE
  126.          if byte$=PGUP$ or byte$=HOME$ then answer$=byte$:return
  127.          if byte$>=F1$ and byte$<=F10$ then answer$=answer$+byte$:return
  128.          if len(answer$)=inlen then return              'check if any more room
  129.      locate inrow,incol+len(answer$):_                  'set for first keystroke
  130.          print byte$;:answer$=answer$+byte$             'echo keystroke
  131.      goto BYTEIN                                  
  132. BACKSPACE:
  133.      if answer$="" then goto BYTEIN                 'entry empty
  134.      print chr$(29);" ";chr$(29);                   'bksp and blank out answer
  135.      answer$=left$(answer$,len(answer$)-1)          'delete last char answer$
  136.      goto BYTEIN
  137.      return
  138. '-------------------------------------------------------------------------------
  139. SHIFT:                                          'converts answer$ to CAPITALS
  140.      for i=1 to len(answer$)
  141.          if asc(mid$(answer$,i,1))>96 and asc(mid$(answer$,i,1))<123 then
  142.               mid$(answer$,i,1) = chr$( asc(mid$(answer$,i,1)) - 32)
  143.          end if
  144.      next:return
  145. DRAWBOX:
  146.     ' must give parameters of height, length, and starting position
  147.     locate 1,1,0
  148.     length = 80:height = 24:startrow = 1:startcol = 1
  149.     l$=string$(length-2,205):j=startcol+length-1
  150.     locate startrow,startcol:print chr$(201)+l$+chr$(187) ' top
  151.     for i=startrow+1 to startrow+(height-2)               ' sides
  152.           locate i,startcol:print chr$(186)
  153.           locate i,j       :print chr$(186)
  154.     next i
  155.     locate i,startcol:print chr$(200)+l$+chr$(188);       ' bottom
  156.     locate 1,1,1
  157.     return
  158. MOVEARROW:
  159.     ' the following line gives an example of parameters needed
  160.     begin%=56:limit%=25:row%=15:increm%=-1:arrow$=string$(2,174)           '««
  161.     locate 1,1,0                                          'turns cursor off
  162.     for i%=begin% to limit% step increm%
  163.           da%=screen(row%,i%):db%=screen(row%,i%+1)
  164.           locate row%,i%:print arrow$;:sound 2000,.5:sound 32767,2
  165.           locate row%,i%:print chr$(da%) chr$(db%);
  166.     '      if i% = 39 and bucket$ = "yes" then  color 2,0 gosub XXXX
  167.     next i%
  168.     locate 1,1,1
  169.     return
  170. FKEYS:  
  171.     'key(1) on:on key(1) gosub HITF1
  172.     'key(2) on:on key(2) gosub HITF2
  173.     'key(3) on:on key(3) gosub HITF3
  174.     'key(4) on:on key(4) gosub HITF4
  175.     'key(5) on:on key(5) gosub HITF5
  176.     'key(6) on:on key(6) gosub HITF6
  177.     'key(7) on:on key(7) gosub HITF7
  178.     'key(8) on:on key(8) gosub HITF8
  179.     'key(9) on:on key(9) gosub HITF9 
  180.     'key(10) on:on key(10) gosub HITF10
  181.      return
  182. '--------------------------- HIT FUNCTION KEY --------------------------------
  183. HITF1:
  184.      locate 22,20:color 15
  185.          print "Hit X to EXIT, any other key to BEGIN again.",e$
  186.          color 7
  187.      gosub IN
  188.      if w$="X" or w$="x" then end else goto BEGINNING
  189.      close:cls
  190.      return
  191. '******************************************************************************
  192. TOP:
  193.      goto MAIN                'bypass for opening screen
  194.      gosub FKEYS
  195.      gosub SETNAMES
  196.      gosub DRAWFRAME
  197.      gosub DRAW3
  198.      gosub DRAW21
  199.      locate 1,27:print "[put program name here]"
  200.      locate 3,31:color 15:print"[ INTRODUCTION ]":color 7
  201.      locate 6,10:print "
  202.      locate 7,10:print "
  203.      locate 8,10:print "
  204.      locate 9,10:print "
  205.      locate 10,10:print"
  206.      locate 11,10:print"
  207.      locate 12,10:print"
  208.      locate 13,10:print"
  209.      locate 14,10:print"
  210.      locate 16,20:print"(c) Copyright 1986 David A. Wesson 
  211.      locate 17,20:print"    238 South Quaker Lane  
  212.      locate 18,20:print"    W. Hartford, CT 06119  203-523-1873"
  213.      locate 19,20:print"    Written for the public domain in QuickBASIC."
  214.      locate 20,20:print"    No charges or liabilities accepted."
  215.      locate 22,20:color 15
  216.           print "Would you like to proceed? ( Y or N ) ":color 7
  217.           gosub YESNO
  218.           if yn$="y" then goto BEGINNING
  219.                 gosub CLEARALL
  220.                 gosub CLEAR22
  221.           locate 15,25:print "OK, thanks for stopping by.":locate 24,1:system
  222. BEGINNING:
  223.      color 7,0:close
  224.      gosub CLEARALL
  225.      gosub CLEAR22
  226. '***************************** MAIN PROGRAM HERE *******************************
  227.  MAIN:
  228.      gosub SETNAMES
  229.      gosub BANNER
  230. '**************************** ERROR HANDLING ROUTINES **************************
  231. NOFIND:
  232.      locate 22,13:color 15
  233.          print"No file by that name found, please fix and restart"
  234.          color 7
  235.      end:system
  236. FINISH:
  237.      locate 16,32:print "Finish time: ";time$
  238.      locate 18,20:print y;" lines processed. Task completed"
  239. HELP:
  240.      print"
  241.      print"
  242.      print"
  243.      print"
  244.      print"
  245.      print"
  246.      print"
  247.      print"
  248.      print"
  249.      print"
  250.  
  251.  
  252.